home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / 3dexp.zip / 3DEXP1.BAS next >
BASIC Source File  |  1992-05-22  |  14KB  |  409 lines
  1. '3DEXP1a.BAS By Rich Geldreich May 22, 1992
  2. 'A fast, QuickBASIC 4.5 3-D wireframe animation program.
  3. 'Compile it for maximum speed!
  4. 'If you have any questions or ideas, please write/call:
  5.  
  6. 'Rich Geldreich
  7. '410 Market St.
  8. 'Gloucester City, NJ 08030
  9. '(609)-742-8752
  10.  
  11. 'The following program is in the public domain! Have fun!
  12.  
  13. DEFINT A-Z
  14. TYPE LineType
  15.     X AS INTEGER
  16.     Y AS INTEGER
  17.     Z AS INTEGER
  18.     X1 AS INTEGER
  19.     Y1 AS INTEGER
  20.     Z1 AS INTEGER
  21. END TYPE
  22. DIM Points(100) AS LineType
  23. DIM Xs(100), Ys(100), Xe(100), Ye(100), Xn(100), Yn(100)
  24. DIM Xs1(100), Ys1(100), Xe1(100), Ye1(100)
  25. DIM X(100), Y(100), Z(100), Pointers1(100), Pointers2(100)
  26. DIM R(100)
  27. DIM Cosine&(360), Sine&(360)
  28. CLS
  29. PRINT "3-D Craft v1a"
  30. PRINT "By Rich Geldreich May 22, 1992"
  31. PRINT
  32. PRINT "Keys to use: (Turn NUMLOCK on!)"
  33. PRINT "Q...............Quits"
  34. PRINT "Numeric keypad..Controls your position(press 5 on the keypad"
  35. PRINT "                to completly stop yourself) "
  36. PRINT "-...............Forward exceleration"
  37. PRINT "+...............Backward exceleration"
  38. PRINT "Arrow keys......Controls the rotation of the craft"
  39. PRINT "F...............Excelerates the craft (Forward)"
  40. PRINT "B...............Slows the craft (Backward)"
  41. PRINT "S...............Stops the craft"
  42. PRINT "A...............Toggles Auto Center, use this when you lose";
  43. PRINT " the craft"
  44. PRINT "C...............Stops the craft's rotation"
  45. PRINT "V...............Resets the craft to starting position"
  46. PRINT
  47. PRINT "Wait a sec..."
  48.  
  49. 'The following for/next loop makes a sine & cosine table.
  50. 'Each sine & cosine is multiplied by 1024 and stored as long integers.
  51. 'This is done so that we don't have to use any slow floating point
  52. 'math at run time.
  53. A = 0
  54. FOR A! = 0 TO 359 / 57.29577951# STEP 1 / 57.29577951#
  55.     Cosine&(A) = INT(.5 + COS(A!) * 1024)
  56.     Sine&(A) = INT(.5 + SIN(A!) * 1024): A = A + 1
  57. NEXT
  58. 'Next we read in all of the lines that are in the object...
  59. FOR A = 0 TO 44
  60.     READ Points(A).X, Points(A).Y, Points(A).Z
  61.     READ Points(A).X1, Points(A).Y1, Points(A).Z1
  62. NEXT
  63. 'Here comes the hard part... Consider this scenario:
  64.  
  65. 'We have two connected lines, like this:
  66.  
  67. '   1--------2 and 3
  68. '            |
  69. '            |
  70. '            |
  71. '            |
  72. '            4
  73. 'Where 1,2, 3, & 4 are the starting and ending points of each line.
  74. 'The first line consists of points 1 & 2  and the second line
  75. 'is made of points 3 & 4.
  76. 'So, you ask, what's wrong? Nothing, really, but don't you see that
  77. 'points 2 and 3 are really at the sample place? Why rotate them twice,
  78. 'that would be a total waste of time? The following code eliminates such
  79. 'occurrences from the line table. (great explanation, huh?)
  80.  
  81. NumberLines = 45
  82. 'take all of the starting & ending points and put them in one big
  83. 'array...
  84. Np = 0
  85. FOR A = 0 TO NumberLines - 1
  86.     X(Np) = Points(A).X
  87.     Y(Np) = Points(A).Y
  88.     Z(Np) = Points(A).Z
  89.     Np = Np + 1
  90.     X(Np) = Points(A).X1
  91.     Y(Np) = Points(A).Y1
  92.     Z(Np) = Points(A).Z1
  93.     Np = Np + 1
  94. NEXT
  95. 'Now set up two sets of pointers that point to each point that a line
  96. 'is made of... (in other words, scan for the first occurrence of each
  97. 'starting and ending point in the point array we just built...)
  98. FOR A = 0 TO NumberLines - 1
  99.     Xs = Points(A).X
  100.     Ys = Points(A).Y
  101.     Zs = Points(A).Z            'get the 3 coordinates of the start point
  102.     FOR B = 0 TO Np - 1         'scan the point array
  103.         IF X(B) = Xs AND Y(B) = Ys AND Z(B) = Zs THEN
  104.             Pointers1(A) = B    'set the pointer to point to the
  105.             EXIT FOR            'point we have just found
  106.         END IF
  107.     NEXT
  108.     Xs = Points(A).X1           'do the same thing that we did above
  109.     Ys = Points(A).Y1           'except scan for the ending point
  110.     Zs = Points(A).Z1           'of each line
  111.     FOR B = 0 TO Np - 1
  112.         IF X(B) = Xs AND Y(B) = Ys AND Z(B) = Zs THEN
  113.             Pointers2(A) = B
  114.             EXIT FOR
  115.         END IF
  116.     NEXT
  117. NEXT
  118. 'Okay, were almost done! All we have to do now is to build a table
  119. 'that tells us which points to actually rotate...
  120. Nr = 0
  121. FOR A = 0 TO NumberLines - 1
  122.     F1 = Pointers1(A)   'get staring & ending point number
  123.     S1 = Pointers2(A)
  124.     IF Nr = 0 THEN      'if this is the first point then it of course
  125.                         'has to be rotated
  126.         R(Nr) = F1: Nr = Nr + 1
  127.     ELSE
  128.         Found = 0       'scan to see if this point already exists...
  129.         FOR B = 0 TO Nr - 1
  130.             IF R(B) = F1 THEN
  131.                 Found = -1: EXIT FOR    'shoot, it's already here!
  132.             END IF
  133.         NEXT
  134.         IF NOT Found THEN R(Nr) = F1: Nr = Nr + 1   'point the point
  135.                                                     'in the array it we
  136.     END IF                                          'can't find it...
  137.         
  138.     Found = 0   'now look for the ending point
  139.     FOR B = 0 TO Nr - 1
  140.         IF R(B) = S1 THEN
  141.             Found = -1: EXIT FOR
  142.         END IF
  143.     NEXT
  144.     IF NOT Found THEN R(Nr) = S1: Nr = Nr + 1
  145. NEXT
  146. PRINT "Press any key to begin..."
  147. A$ = INPUT$(1)
  148. 'The following sets up the rotation & perspective variables.
  149.  
  150. 'Vs = the screen that is currently being viewed
  151. 'Ws = the screen that is currently being worked on
  152. Vs = 1: Ws = 0
  153.  
  154. 'Deg1 & Deg2 are the two angles of rotation
  155. 'D1 & D2 are the deltas of each axes. If D1 = -5, for instance, then
  156. 'Deg1 will be decreased 5 degress every frame.
  157. Deg1 = 0: Deg2 = 0: D1 = 0: D2 = 0
  158.  
  159. 'Spos & Mypos are for the perspective routines...
  160. 'Spos is the screen's Z coordinate and Mypos is the users Z coordinate
  161. Spos = -250: Mypos = 0
  162.  
  163. 'Mx, My, and Mz are the coordinates of the user.
  164. 'Ox, Oy, and Oz are the coordinates of the craft.
  165. Mx = 0: My = 0: Mz = 0: Ox = 0: Oy = 0: Oz = -260
  166. 'main loop
  167. NumberOfFrames = 0
  168. DEF SEG = &H40
  169. StartTime = PEEK(&H6C)
  170. DO
  171.  
  172.     'swap the viewing and working screens for page flipping...
  173.     SWAP Vs, Ws
  174.     SCREEN 9, , Ws, Vs
  175.     
  176.     'adjust the angles according to their deltas...
  177.     Deg1 = (Deg1 + D1) MOD 360
  178.     Deg2 = (Deg2 + D2) MOD 360
  179.     'fix the angles up if they go out of range
  180.     IF Deg1 < 0 THEN Deg1 = Deg1 + 360
  181.     IF Deg2 < 0 THEN Deg2 = Deg2 + 360
  182.     'get the sine and cosine of each angle from the tables
  183.     'that were prepared at the beginning of the program
  184.     C1& = Cosine&(Deg1): S1& = Sine&(Deg1)
  185.     C2& = Cosine&(Deg2): S2& = Sine&(Deg2)
  186.  
  187.     'now we must adjust the object's coordinates
  188.     'based on how quickly it is moving...
  189.    
  190.     X = Speed: Y = 0: Z = 0
  191.  
  192.     X1 = (X * C1&) \ 1024: Y1 = (X * S1&) \ 1024
  193.     X2 = (X1 * C2&) \ 1024: Zn = (X1 * S2&) \ 1024
  194.     Ox = Ox + X2: Oy = Oy + Y1: Oz = Oz + Zn
  195.     IF Oz > 32000 THEN Oz = 32000
  196.     IF Oz < -32000 THEN Oz = -32000
  197.     IF Ox > 32000 THEN Ox = 32000
  198.     IF Ox < -32000 THEN Ox = -32000
  199.     IF Oy > 32000 THEN Oy = 32000
  200.     IF Oy < -32000 THEN Oy = -32000
  201.    
  202.     'if Atloc is true then Auto-Center is on...
  203.     IF AtLoc THEN
  204.         Mx = Mx + (Ox - Mx) \ 4
  205.         My = My + (Oy - My) \ 4
  206.         Mz = Mz + ((Oz + 200) - Mz) \ 4
  207.     ELSE
  208.         'adjust the users position based on how much he is moving...
  209.         Mz = Mz + Mzm: Mx = Mx + Mxm: My = My + Mym
  210.         IF Mz > 32000 THEN Mz = 32000
  211.         IF Mz < -32000 THEN Mz = -32000
  212.         IF Mx > 32000 THEN Mx = 32000
  213.         IF Mx < -32000 THEN Mx = -32000
  214.         IF My > 32000 THEN My = 32000
  215.         IF My < -32000 THEN My = -32000
  216.     END IF
  217.     '(Wait for vertical retrace, reduces flicker. This was recommended
  218.     'by someone on the echo but I can't remember who! Thanks)
  219.     WAIT &H3DA, 8
  220.     'erase the old lines...
  221.     IF Ws = 1 THEN
  222.         FOR A = 0 TO Ln(Ws) - 1
  223.             LINE (Xs1(A), Ys1(A))-(Xe1(A), Ye1(A)), 0
  224.         NEXT
  225.     ELSE
  226.         FOR A = 0 TO Ln(Ws) - 1
  227.             LINE (Xs(A), Ys(A))-(Xe(A), Ye(A)), 0
  228.         NEXT
  229.     END IF
  230.     'print frames per second
  231.     LOCATE 1, 1: PRINT A$
  232.     'rotate the points...
  233.     FOR A = 0 TO Nr - 1
  234.         R = R(A): Xo = X(R): Yo = Y(R): Zo = Z(R)
  235.         X1 = (Xo * C1& - Yo * S1&) \ 1024
  236.         Y1& = (Xo * S1& + Yo * C1&) \ 1024 - My + Oy
  237.         X1& = (X1 * C2& - Zo * S2&) \ 1024 - Mx + Ox
  238.         Zn = (X1 * S2& + Zo * C2&) \ 1024 - Mz + Oz
  239.         'if the point is too close(or behind) the viewer then
  240.         'don't draw it...
  241.         IF (Mypos - Zn) < 15 THEN
  242.             Xn(R) = -1: Yn(R) = 0: Zn = 0
  243.         ELSE
  244.             'Put the point into perspective...
  245.             'The original formula was:
  246.             'Xnew=Xnew+( -Xold * ( (Spos-Z) / (MPos-Z) ) )
  247.             'Ynew=Ynew=( -Yold * ( (Spos-Z) / (Mpos-Z) ) )
  248.             V = (1330& * (Spos - Zn)) \ (Mypos - Zn)
  249.             Xn(R) = 320 + X1& + (-X1& * V) \ 1330
  250.            
  251.             'The Y coordinate is also multiplied by .8 to adjust
  252.             'for SCREEN 9's height to width ratio...
  253.            
  254.             Yn(R) = 175 + (8 * (Y1& + (-Y1& * V) \ 1330)) \ 10
  255.         END IF
  256.     NEXT
  257.     'draw the lines...
  258.     '(There are two seperate cases, each puts it's coordinates
  259.     'in a different array for later erasing. I could of used a
  260.     '2 dimensional array for this but that is slower.)
  261.     IF Ws = 1 THEN
  262.         Ln = 0
  263.         FOR A = 0 TO NumberLines - 1
  264.             F1 = Pointers1(A): S1 = Pointers2(A)
  265.             Xn = Xn(F1): Yn = Yn(F1)
  266.             'if Xn<>-1 then it's in view...
  267.             IF Xn <> -1 THEN
  268.                 IF Xn(S1) <> -1 THEN
  269.                     X1 = Xn(S1): Y1 = Yn(S1)
  270.                     LINE (X1, Y1)-(Xn, Yn), 14
  271.                     'store the lines so they can be erased later...
  272.                     Xs1(Ln) = X1: Ys1(Ln) = Y1
  273.                     Xe1(Ln) = Xn: Ye1(Ln) = Yn
  274.                     Ln = Ln + 1
  275.                 END IF
  276.             END IF
  277.         NEXT
  278.     ELSE
  279.         Ln = 0
  280.         FOR A = 0 TO NumberLines - 1
  281.             F1 = Pointers1(A): S1 = Pointers2(A)
  282.             Xn = Xn(F1): Yn = Yn(F1)
  283.             'if Xn<>-1 then it's in view...
  284.             IF Xn <> -1 THEN
  285.                 IF Xn(S1) <> -1 THEN
  286.                     X1 = Xn(S1): Y1 = Yn(S1)
  287.                     LINE (X1, Y1)-(Xn, Yn), 14
  288.                     'store the lines so they can be erased later...
  289.                     Xs(Ln) = X1: Ys(Ln) = Y1
  290.                     Xe(Ln) = Xn: Ye(Ln) = Yn
  291.                     Ln = Ln + 1
  292.                 END IF
  293.             END IF
  294.         NEXT
  295.     END IF
  296.     Ln(Ws) = Ln
  297.     K$ = UCASE$(INKEY$)
  298.     'Process the keystroke(if any)...
  299.     IF K$ <> "" THEN
  300.         SELECT CASE K$
  301.             CASE "A"
  302.                 AtLoc = NOT AtLoc
  303.             CASE "+"
  304.                 Mzm = Mzm + 2
  305.             CASE "-"
  306.                 Mzm = Mzm - 2
  307.             CASE "5"
  308.                 Mxm = 0: Mym = 0: Mzm = 0
  309.             CASE "4"
  310.                 Mxm = Mxm - 2
  311.             CASE "6"
  312.                 Mxm = Mxm + 2
  313.             CASE "8"
  314.                 Mym = Mym - 2
  315.             CASE "2"
  316.                 Mym = Mym + 2
  317.             CASE "F"
  318.                 Speed = Speed + 5
  319.             CASE "B"
  320.                 Speed = Speed - 5
  321.             CASE "C"
  322.                 D1 = 0: D2 = 0
  323.             CASE "S"
  324.                 Speed = 0
  325.             CASE CHR$(0) + CHR$(72)
  326.                 D1 = D1 + 1
  327.             CASE CHR$(0) + CHR$(80)
  328.                 D1 = D1 - 1
  329.             CASE CHR$(0) + CHR$(75)
  330.                 D2 = D2 - 1
  331.             CASE CHR$(0) + CHR$(77)
  332.                 D2 = D2 + 1
  333.             CASE "Q", CHR$(27)
  334.                 SCREEN 0, , 0, 0
  335.                 CLS
  336.                 PRINT "By Rich Geldreich May 22, 1992"
  337.                 PRINT "See ya later!"
  338.                 END
  339.             CASE "V"
  340.                 D1 = 0: D2 = 0: Deg1 = 0: Deg2 = 0: Speed = 0
  341.         END SELECT
  342.     END IF
  343.     NumberOfFrames = NumberOfFrames + 1
  344.     'see if 20 frames have passed; if so then see
  345.     'how long it took...
  346.     IF NumberOfFrames = 20 THEN
  347.         TotalTime = PEEK(&H6C) - StartTime
  348.         IF TotalTime < 0 THEN TotalTime = TotalTime + 256
  349.         FramesPerSecX100 = 36400 \ TotalTime
  350.         High = FramesPerSecX100 \ 100
  351.         Low = FramesPerSecX100 - High
  352.         'A$ has the string that is printed at the upper left
  353.         'corner of the screen
  354.         A$ = MID$(STR$(High), 2) + "."
  355.         A$ = A$ + RIGHT$("0" + MID$(STR$(Low), 2), 2) + "  "
  356.         NumberOfFrames = 0
  357.         StartTime = PEEK(&H6C)
  358.     END IF
  359. LOOP
  360. 'The following data is the shuttle craft...
  361. 'stored as Start X,Y,Z & End X,Y,Z
  362. DATA -157,22,39,-157,-18,39
  363. DATA -157,-18,39,-127,-38,39
  364. DATA -127,-38,39,113,-38,39
  365. DATA 113,-38,39,193,12,39
  366. DATA 33,42,39,33,42,-56
  367. DATA 33,42,-56,-127,42,-56
  368. DATA -127,42,-56,-157,22,-56
  369. DATA -157,22,-56,-157,22,39
  370. DATA -157,22,-56,-157,-18,-56
  371. DATA -157,-18,-56,-157,-18,39
  372. DATA -157,-18,-56,-127,-38,-56
  373. DATA -127,-38,-56,-127,-38,39
  374. DATA -127,-38,-56,113,-38,-56
  375. DATA 113,-38,-56,113,-38,39
  376. DATA 113,-38,-56,193,12,-56
  377. DATA 193,12,-56,193,12,39
  378. DATA -157,22,-56,193,12,-56
  379. DATA 193,12,39,-157,22,39
  380. DATA -56,-13,41,-56,-3,41
  381. DATA -56,-3,41,-26,-3,41
  382. DATA -26,-3,41,-26,7,41
  383. DATA -51,7,41,-31,-13,41
  384. DATA -11,-13,41,-11,-3,41
  385. DATA -11,-3,41,-1,7,41
  386. DATA 9,7,41,9,-8,41
  387. DATA 9,-8,41,24,-8,41
  388. DATA 34,16,41,34,-38,41
  389. DATA 33,-39,41,33,-39,-53
  390. DATA 33,-39,-53,33,15,-53
  391. DATA -42,-38,19,-72,-38,19
  392. DATA -72,-38,19,-72,-38,-41
  393. DATA -72,-38,-41,-42,-38,-41
  394. DATA -42,-38,-41,-42,-38,19
  395. DATA 33,42,39,34,16,41
  396. DATA 33,42,-56,33,15,-53
  397. DATA -157,22,39,-127,42,39
  398. DATA -127,42,-56,-127,42,39
  399. DATA -127,42,39,33,42,39
  400. DATA 159,-8,-56,159,-8,40
  401. DATA 143,-18,-56,143,-18,39
  402. DATA 193,12,39,193,32,30
  403. DATA 33,42,39,193,32,30
  404. DATA 193,32,30,193,32,-47
  405. DATA 33,42,-56,193,32,-47
  406. DATA 193,12,-56,193,32,-47
  407.  
  408.  
  409.